home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / SplatMaster / DlogStuff.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-01  |  16.5 KB  |  444 lines  |  [TEXT/PJMM]
  1. unit DlogStuff;
  2. interface
  3.     uses
  4.         Quickdraw, Picker, Palettes, SANE, WindowStuff;
  5.  
  6.     const
  7.         OK_ALRT_ID = 1005;
  8.         YN_ALRT_ID = 1006;
  9.         YNC_ALRT_ID = 1007;
  10.  
  11.     procedure DoMessage (mes0: str255; mes1: str255; mes2: str255; mes3: str255);
  12.     procedure DoOneLiner (mes0: str255);
  13.     procedure Do_OK_ALRT;
  14.     function Do_YN_ALRT: Boolean;
  15.     function Do_YNC_Alrt: integer;
  16.     function CheckForStop (theEvent: EventRecord): boolean;
  17.     procedure DrawDefaultBtn (theItem: integer; thisDlog: DialogPtr);
  18.     procedure HiLiteDLOGButton (theItem: integer; state: boolean; thisDlog: DialogPtr);
  19.     procedure ClickButton (Dptr: DialogPtr; ItemNo: integer);
  20.     procedure DLOGTitle (title, FcnName: str255);
  21.     function GetDBox (theDLOG: dialogPtr; theItem: integer): rect;
  22.     function GetDLOGIHandle (theDLOG: dialogPtr; theItem: integer): Handle;
  23.     procedure WriteLabel (theStr: Str255; theRect: rect; toTheRight: boolean);
  24.     procedure ZoomRect (zoomUp: boolean; smallRect, bigRect: rect);
  25.     procedure ShadowBox (theRect: Rect);
  26.  
  27.     procedure Add_List_String (theString: Str255; theList: ListHandle);
  28.  
  29.     procedure PushRadioButton (theDlog: dialogPtr; item, first, last: integer);
  30.     procedure CheckABox (theDlog: dialogPtr; ItemNum: integer; HighLite: boolean);
  31.     procedure TrackScroll (theControl: ControlHandle; partCode: Integer);
  32.  
  33.  
  34.     function IsStringReal (theStr: str255; var ItsBadBecause: str255): boolean;
  35.     function String2Int (theStr: str255): integer;
  36.     function Int2String (theInt: integer): str255;
  37.     function String2Real (aStr: str255): real;
  38.     function Real2String (aReal: real): str255;
  39.  
  40. implementation
  41.  
  42.  
  43.  
  44. {=======================================================================================    }
  45.     procedure DoMessage; {(mes0 : str255;mes1 : str255; mes2 : str255;mes3 : str255);}
  46.         const
  47.             MessageDialog = 258;
  48.         var
  49.             dialogP: DialogPtr;
  50.             item: integer;
  51.             oldPort: grafPtr;
  52.     begin
  53.         GetPort(oldPort);
  54.         ParamText(mes0, mes1, mes2, mes3);
  55.         dialogP := GetNewDialog(MessageDialog, nil, pointer(-1));
  56.         if dialogP = nil then
  57.             begin
  58.                 SysBeep(5);
  59.             end
  60.         else
  61.             begin
  62.                 CenterWindow(dialogP);
  63.                 ShowWindow(dialogP);
  64.                 InitCursor;
  65.                 ModalDialog(nil, item);
  66.                 DisposDialog(dialogP);
  67.             end;
  68.         SetPort(oldPort);
  69.     end; {DoMessage}
  70.  
  71.  
  72. {======================================================================================= }
  73.     procedure DoOneLiner; {(mes0: Str255)}
  74.     begin
  75.         DoMessage(mes0, '', '', '');
  76.     end; {DoOneLiner}
  77.  
  78.  
  79. {======================================================================================= }
  80. {Make sure your message has already been prepared using ParamText}
  81.     procedure Do_OK_ALRT;
  82.         var
  83.             oldPort: GrafPtr;
  84.             dummy: integer;
  85.     begin
  86.         GetPort(oldPort);
  87.         dummy := StopAlert(OK_ALRT_ID, nil);
  88.         SetPort(oldPort);
  89.     end;        {Do_OK_ALRT}
  90.  
  91.  
  92. {======================================================================================= }
  93. {Make sure your message has already been prepared using ParamText}
  94.     function Do_YN_ALRT: Boolean;
  95.         var
  96.             oldPort: GrafPtr;
  97.     begin
  98.         GetPort(oldPort);
  99.         if (Alert(YN_ALRT_ID, nil) = 1) then
  100.             Do_YN_ALRT := TRUE
  101.         else
  102.             Do_YN_ALRT := FALSE;
  103.         SetPort(oldPort);
  104.     end;        {Do_YN_ALRT}
  105.  
  106.  
  107.  
  108. {======================================================================================= }
  109. {Make sure your message has already been prepared using ParamText}
  110.     function Do_YNC_Alrt: integer;
  111.         var
  112.             oldPort: GrafPtr;
  113.     begin
  114.         GetPort(oldPort);
  115.         Do_YNC_Alrt := Alert(YNC_ALRT_ID, nil);
  116.         SetPort(oldPort);
  117.     end;        {Do_YNC_Alrt}
  118.  
  119.  
  120. {======================================================================================= }
  121.     {This is a routine used to add strings to an existing list}
  122.     procedure Add_List_String; {(theString: Str255; theList: ListHandle)}
  123.         var
  124.             theRow: integer;             {The Row that we are adding}
  125.             aStr: str255;
  126.             aPt: point;
  127.     begin
  128.         if (theList <> nil) then
  129.             begin
  130.                 aPt.h := 0;                                           {Point to the correct column}
  131.                 theRow := LAddRow(1, 200, theList);            {Add another row at the end of the list}
  132.                 aPt.v := theRow;                                    {Point to the row just added}
  133.                 aStr := theString;{Get the string to add}
  134.                 LSetCell(Pointer(ord(@aStr) + 1), length(aStr), aPt, theList);{Place string in row just created}
  135.                 LDraw(aPt, theList);                                {Draw the new string}
  136.             end;
  137.     end;
  138.  
  139.  
  140. {======================================================================================= }
  141. {--------------------Scan Event Queue for Cmd-Period---------------------}
  142.  
  143. {example of code that might call CheckForStop }
  144. {    itsAnEvent := EventAvail(keyDownMask, myEvent);}
  145. {    if itsAnEvent then}
  146. {    begin}
  147. {    if CheckForStop(myEvent) then}
  148. {    goto 99;}
  149. {    end;}
  150.  
  151.     function CheckForStop;{ (theEvent : EventRecord) : boolean}
  152.         type
  153.             Trick = packed record
  154.                     case boolean of
  155.                         true: (
  156.                                 long: Longint
  157.                         );
  158.                         false: (
  159.                                 chr3, chr2, chr1, chr0: char
  160.                         )
  161.                 end;
  162.         var
  163.             CharCode: char;
  164.             TrickVar: Trick;
  165.             stop: boolean;
  166.             periodKey: char;
  167.     begin
  168.         stop := FALSE;
  169.         periodKey := chr(46);
  170.         TrickVar.long := theEvent.message;
  171.         CharCode := TrickVar.chr0;
  172.         if BitAnd(theEvent.modifiers, CmdKey) = CmdKey then
  173.             if CharCode = periodKey then
  174.                 stop := TRUE;
  175.         CheckForStop := stop;
  176.     end;
  177.  
  178. {--------------------Check/Uncheck CheckBoxes in DLOGs---------------------}
  179.     procedure CheckABox;{(theDlog:dialogPtr; ItemNum : integer;HighLite : boolean);}
  180.         var
  181.             itemtype: integer;                {the dialog items type}
  182.             itemhandle: handle;                {the dialog items handle}
  183.             itemrect: rect;                    {the dialog items rect}
  184.             itemcntlhand: controlhandle;    {we convert the items handle to a cntl handle}
  185.  
  186.     begin
  187.         GetDItem(theDlog, ItemNum, itemtype, itemhandle, itemrect); {get the handle}
  188.         itemcntlhand := controlhandle(itemhandle); {convert it to a cntl handle}
  189.         if HighLite then
  190.             begin
  191.                 SetCtlValue(itemcntlhand, 1); {hilite the control}
  192.             end
  193.         else
  194.             begin
  195.                 SetCtlValue(itemcntlhand, 0); {unlilite the control}
  196.             end;
  197.     end;
  198.  
  199. {-----------------Track User's Use of Scrollbar---------------}
  200.  
  201.     procedure TrackScroll; {(theControl: ControlHandle; partCode: Integer)}
  202.         var
  203.             min, max, amount, startValue: Integer;
  204.             up: Boolean;
  205.     begin
  206.         up := partcode in [inUpButton, inPageUp];
  207.         min := GetCtlMin(theControl);
  208.         max := GetCtlMax(theControl);
  209.         startValue := GetCtlValue(theControl);
  210.         if ((up and (startValue > min)) or ((not up) and (startValue < max))) and (partCode <> 0) then
  211.             begin
  212.                 if up then
  213.                     amount := -1
  214.                 else
  215.                     amount := 1;
  216.                 if partCode in [inPageUp, inPagedown] then
  217.                     amount := round(amount * 5)
  218.                 else
  219.                     amount := round(amount * 1);
  220.                 SetCtlValue(theControl, amount + startValue);
  221.             end;
  222.     end; {of TrackScroll}
  223.  
  224. {--------------------HiLite/UnHilite Radio Buttons---------------------}
  225.     procedure PushRadioButton; {(theDlog : dialogPtr; item, first, last : integer)}
  226.  
  227.         var
  228.             index: integer;        {index through the loop}
  229.             itemtype: integer;        {the dialog items type}
  230.             itemhandle: handle;        {the dialog items handle}
  231.             itemrect: rect;        {the dialog items rect}
  232.             itemcntlhand: controlhandle; {we convert the items handle to a cntl handle}
  233.  
  234.     begin
  235.         for index := first to last do {do it for all items in the group}
  236.             begin
  237.                 GetDItem(theDlog, index, itemtype, itemhandle, itemrect); {get the handle}
  238.                 itemcntlhand := controlhandle(itemhandle); {convert it to a cntl handle}
  239.                 if (index = item) then
  240.                     begin
  241.                         SetCtlValue(itemcntlhand, 1); {hilite the control}
  242.                     end
  243.                 else
  244.                     SetCtlValue(itemcntlhand, 0); {unlilite the control}
  245.             end;
  246.     end;
  247.  
  248. {--------------------Outline DLOGs Default Button---------------------}
  249.     procedure DrawDefaultBtn; {(theItem : integer; thisDlog : DialogPtr);}
  250.         var
  251.             OptType: Integer;
  252.             OptBox: Rect;
  253.             ItemHdl: Handle;
  254.             oldDlog: DialogPtr;
  255.  
  256.     begin
  257.         GetPort(oldDlog);
  258.         SetPort(thisDlog);{ set window to current graf port }
  259. {Note: GetDItem gets info about dialogs}
  260.         GetDItem(thisDlog, theItem, OptType, ItemHdl, OptBox);  { get item location }
  261.         Pensize(3, 3);                                     { no wimpy outlines here }
  262.         InsetRect(OptBox, -4, -4);                 { set rectangle around button }
  263.         FrameRoundRect(OptBox, 16, 16);         { draw the sucker! }
  264.         PenSize(1, 1);                            { reset the PenSize}
  265.         SetPort(oldDlog);                            { RESET to the original port}
  266.     end; { of proc DrawDefaultBtn }
  267.  
  268.  
  269.     procedure HiLiteDLOGButton; {(theItem: integer; state: boolean; thisDlog: DialogPtr)}
  270.         const
  271.             on = TRUE;
  272.             off = FALSE;
  273.         var
  274.             tipe: integer;
  275.             aHdl: Handle;
  276.             tempRect: rect;
  277.     begin
  278.         GetDItem(thisDlog, theItem, tipe, aHdl, tempRect);    {Get the item handle}
  279.  
  280.         if state = on then
  281.             HiliteControl(controlhandle(aHdl), 0)                {un-dim button}
  282.         else
  283.             HiliteControl(controlhandle(aHdl), 255);            {Dim the button}
  284.     end;{}
  285.  
  286. {--------------------Draw DLOG Title-------
  287.                 rect4.right := ZoomBlend(smallRect.right, bigRect.right);
  288.                 rect4.top := ZoomBlend(smallRect.top, bigRect.top);
  289.                 rect4.bottom := ZoomBlend(smallRect.bottom, bigRect.bottom);
  290.  
  291.                 FrameRect(rect4);
  292.                 FrameRect(rect1);
  293.                 rect1 := rect2;
  294.                 rect2 := rect3;
  295.                 rect3 := rect4;
  296.  
  297.                 fract := FixMul(fract, factor);
  298.             end;
  299.         FrameRect(rect1);
  300.         FrameRect(rect2);
  301.         FrameRect(rect3);
  302.         PenNormal;
  303.     end;
  304.  
  305. {===========================================================}
  306. {draws a 2-pixel shadow around a rectangle}
  307.     procedure ShadowBox; {(theRect: Rect)}
  308.     begin
  309.         PenSize(2, 2);
  310.         with theRect do
  311.             begin
  312.                 MoveTo(left + 2, bottom);
  313.                 LineTo(Right, bottom);
  314.                 MoveTo(right, Top + 2);
  315.                 LineTo(Right, Bottom);
  316.             end;
  317.         PenSize(1, 1);
  318.         FrameRect(theRect);
  319.     end;{ShadowBox}
  320.  
  321.  
  322.  
  323.  
  324. {--------------------Simulate MouseDown in Button---------------------}
  325.     procedure ClickButton; {(Dptr : DialogPtr; ItemNo : integer);}
  326.  
  327. {    Inside Macintosh leaves out the fact that if you use a filter procedure        }
  328. {in the ModalDialog call you need to simulate a clicking of the OK button when    }
  329. {the return key is hit.  This one of two possible techniques where we directly    }
  330. {highlight and unhighlight the button.  The other technique would be to add a     }
  331. {mouse down event to the event queue in which the mouse coordinates are         }
  332. {somewhere inside of the OK button.  JWIND}
  333.  
  334.         var
  335.             IType: integer;
  336.             ButtonHandle: Handle;
  337.             Box: rect;
  338.             L: LongInt;
  339.  
  340.     begin
  341.         GetDItem(Dptr, ItemNo, IType, ButtonHandle, Box);
  342.         HiliteControl(ControlHandle(ButtonHandle), 253);
  343.         Delay(8, L);
  344.         HiliteControl(ControlHandle(ButtonHandle), 0);
  345.     end; { ClickButton }
  346.  
  347.  
  348. {check to see if the string passed contains only numerals and a decimal}
  349. {Returns a string explaining what was wring, if anything}
  350.     function IsStringReal; {(theStr : str255; var ItsBadBecause : str255) : boolean;}
  351.         label
  352.             99;
  353.         var
  354.             i, decimalFound, negativesFound: integer;
  355.             aChar: char;
  356.             Okay: boolean;
  357.     begin
  358.         okay := TRUE;
  359.         decimalFound := 0;
  360.         negativesFound := 0;
  361.         ItsBadBecause := '';
  362.         for i := 1 to length(theStr) do
  363.             begin
  364.                 aChar := Copy(theStr, i, 1);
  365.                 if aChar = '.' then
  366.                     decimalFound := decimalFound + 1;
  367.                 if decimalFound > 1 then
  368.                     begin
  369.                         ItsBadBecause := 'Too many decimals found';
  370.                         okay := FALSE;
  371.                         goto 99;
  372.                     end;{if decimalFound > 1 then}
  373.                 if aChar = '-' then
  374.                     negativesFound := negativesFound + 1;
  375.                 if negativesFound > 1 then
  376.                     begin
  377.                         ItsBadBecause := 'Too many "-"s found ';
  378.                         okay := FALSE;
  379.                         goto 99;
  380.                     end;{if negativesFound > 1 then}
  381.                 if not (aChar in ['0'..'9', '-', '.']) then
  382.                     begin
  383.                         ItsBadBecause := Concat('Non-numeric character found: ', aChar);
  384.                         okay := FALSE;
  385.                         goto 99;
  386.                     end;{if not aChar in ['0'..'9', '-','.'] then}
  387.             end;{for i := 1 to length(theStr)}
  388. 99:
  389.         IsStringReal := Okay;
  390.     end;{IsStringReal}
  391.  
  392.  
  393.  
  394.  
  395.  
  396. {----------------Convert a Numeric String to an Integer----------------}
  397.     function String2Int;{(theStr) : integer;}
  398.         var
  399.             aLongInt: longint;
  400.     begin
  401.         StringToNum(theStr, aLongInt);
  402.         if aLongInt > maxInt then
  403.             begin
  404.                 DoMessage('That number is too big.', 'It must be less than 32767', '', '');
  405.                 aLongInt := 0;
  406.             end;
  407.         String2Int := aLongInt;
  408.     end;{String2Int}
  409.  
  410. {----------------Convert a Numeric String to an Integer----------------}
  411.     function Int2String; {(theInt) : str255;}
  412.         var
  413.             aLongInt: longint;
  414.             aStr: str255;
  415.     begin
  416.         aLongInt := theInt;
  417.         NumToString(aLongInt, aStr);
  418.         Int2String := aStr;
  419.     end;{String2Int}
  420.  
  421.  {--------------------Convert a Real to a Str255---------------------}
  422.     function Real2String; {(aReal : real) : str255;}
  423.         var
  424.             aDecForm: DecForm;
  425.             aDecStr: DecStr;
  426.             aStr: str255;
  427.     begin
  428.         aDecform.Style := FixedDecimal;
  429.         aDecform.digits := 2;
  430.         Num2Str(aDecForm, aReal, aDecStr);
  431.         aStr := aDecStr;
  432.         Real2String := aStr;
  433.     end;{Real2Str}
  434.  
  435.  {--------------------Convert a Str255 to a Real---------------------}
  436. {This is actually very simple…}
  437.     function String2Real; {(aStr : str255) : real;}
  438.     begin
  439.         String2Real := Str2Num(aStr);
  440.     end;{String2Real}
  441.  
  442.  
  443.  
  444. end.